home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 May: Tool Chest / Dev.CD May 98 TC.toast / Tool Chest / Development Kits / HyperCard Related / APDA HyperCard Toolkits / HyperCard CTB Toolkit 1.0b2 / Source Code / CTBNewFileTransfer.p < prev    next >
Encoding:
Text File  |  1995-02-07  |  3.1 KB  |  107 lines  |  [TEXT/MPS ]

  1. (*
  2.     CTBNewFileTransfer [tool] -- Make a new file transfer tool. If one is open, dispose of it. The tool
  3.         parameter is the name of the tool to use initially.
  4.  
  5.     To compile and link this file using Macintosh Programmer's Workshop,
  6.  
  7.         pascal -w CTBNewFileTransfer.p
  8.         link -m ENTRYPOINT -o HyperCommands -rt XCMD=2757 -sn Main=CTBNewFileTransfer ∂
  9.             CTBNewFileTransfer.p.o "{MPW}"Libraries:interface.o "{MPW}"Libraries:Libraries:HyperXLib.o
  10.  
  11.     © Copyright 1990 by Apple Computer, Inc.
  12.  
  13.     Initial coding 2/90 by Harry R. Chesley.
  14. *)
  15.  
  16. {$R-}
  17.  
  18. {$S CTBNewFileTransfer }     { Segment name must be the same as the command name. }
  19.  
  20. unit DummyUnit;
  21.  
  22. interface
  23.  
  24. uses MemTypes, QuickDraw, OSIntf, ToolIntf, CTBUtils, FTIntf, CMIntf, TMIntf, CRMIntf, HyperXCmd;
  25.  
  26. procedure EntryPoint(paramPtr: XCmdPtr);
  27.     
  28. implementation
  29.  
  30. procedure CTBNewFileTransfer(paramPtr: XCmdPtr); forward;
  31.  
  32. procedure EntryPoint(paramPtr: XCmdPtr);
  33.  
  34.     begin
  35.         CTBNewFileTransfer(paramPtr);
  36.     end;
  37.  
  38. procedure CTBNewFileTransfer(paramPtr: XCmdPtr);
  39.  
  40.     {$I CTBUtil.inc}
  41.  
  42.     var i, j: integer;
  43.         toolName: Str255;
  44.         procID: integer;
  45.         ftHand: FTHandle;
  46.  
  47.     procedure Fail(errMsg: Str255); { set theResult and quit }
  48.         begin
  49.             paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
  50.             exit(CTBNewFileTransfer);
  51.         end;
  52.  
  53.     begin
  54.         { Verify the number of parameters. }
  55.         if paramPtr^.paramCount> 1 then Fail('Invalid parameter count');
  56.  
  57.         { Make sure the Comm Toolbox is present and ready. }
  58.         CTBReady;
  59.  
  60.         { If there's already a file transfer tool open, close it. }
  61.         if Globals^^.FTHand <> nil then
  62.             begin
  63.                 { Dispose of the tool. }
  64.                 FTDispose(Globals^^.FTHand);
  65.                 { Remove it from the outstanding tool list. }
  66.                 j := 1;
  67.                 for i := 1 to Globals^^.allToolsSize do
  68.                     if Globals^^.allTools[i].ftHand <> Globals^^.FTHand then
  69.                         begin
  70.                             Globals^^.allTools[j] := Globals^^.allTools[i];
  71.                             j := j+1;
  72.                         end;
  73.                 Globals^^.allToolsSize := Globals^^.allToolsSize-1;
  74.                 SetHandleSize(Handle(Globals),sizeof(OurGlobalType)-sizeof(ToolArray)+
  75.                                             Globals^^.allToolsSize*sizeof(OneToolType));
  76.                 Globals^^.FTHand := nil;
  77.             end;
  78.  
  79.         { Find the proc ID. }
  80.         if ParmPresent(1) then GetStrParm(1,toolName)
  81.         else toolName := 'Text Tool';
  82.         { Look up the ID. }
  83.         procID := FTGetProcID(toolName);
  84.         if procID = -1 then
  85.             begin
  86.                 { If we couldn't get the one we wanted, then just get any one. }
  87.                 if CRMGetIndToolName(ClassFT,1,toolName) <> noErr then procID := -1
  88.                 else procID := FTGetProcID(toolName);
  89.                 { If there are no file transfer tools at all, fail. }
  90.                 if procID = -1 then Fail('Could not find a default tool');
  91.             end;
  92.  
  93.         { Create the new connection handle. }
  94.         ftHand := FTNew(procID,ftNoMenus+ftQuiet,nil,nil,nil,nil,nil,nil,0,0);
  95.         if ftHand = nil then Fail('Could not create new file transfer record');
  96.         { Save it. }
  97.         Globals^^.FTHand := ftHand;
  98.         { Add it to the outstanding tools list. }
  99.         Globals^^.allToolsSize := Globals^^.allToolsSize+1;
  100.         SetHandleSize(Handle(Globals),sizeof(OurGlobalType)-sizeof(ToolArray)+
  101.                                     Globals^^.allToolsSize*sizeof(OneToolType));
  102.         Globals^^.allTools[Globals^^.allToolsSize].tType := fileTransferTool;
  103.         Globals^^.allTools[Globals^^.allToolsSize].ftHand := Globals^^.FTHand;
  104.     end;
  105.  
  106. end.
  107.